home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / PowerLisp 2.01 / PowerLisp 2.01 ƒ / Library / documentation.lisp < prev    next >
Lisp/Scheme  |  1996-05-26  |  6KB  |  202 lines
  1. ;;;
  2. ;;;        PowerLisp 2.0
  3. ;;;        Copyright © 1996 Roger Corman.  All rights reserved.
  4. ;;;
  5. ;;;
  6. ;;;        Common Lisp 'documentation' function.
  7. ;;;
  8. (in-package :common-lisp)
  9. (provide :documentation)
  10.  
  11. ;;;;
  12. ;;;;    documentation.lisp
  13. ;;;;
  14. ;;;;    This file contains code relating to the online help
  15. ;;;;    facility in PowerLisp, and the CLTL2 browser.
  16. ;;;;
  17.  
  18. (defvar cltl2-chapters
  19. '(
  20. "Chapter 01. Introduction"
  21. "Chapter 02. Data Types"
  22. "Chapter 03. Scope and Extent"
  23. "Chapter 04. Type Specifiers"
  24. "Chapter 05. Program Structure"
  25. "Chapter 06. Predicates"
  26. "Chapter 07. Control Structure"
  27. "Chapter 08. Macros"
  28. "Chapter 09. Declarations"
  29. "Chapter 10. Symbols"
  30. "Chapter 11. Packages"
  31. "Chapter 12. Numbers"
  32. "Chapter 13. Characters"
  33. "Chapter 14. Sequences"
  34. "Chapter 15. Lists"
  35. "Chapter 16. Hash Tables"
  36. "Chapter 17. Arrays"
  37. "Chapter 18. Strings"
  38. "Chapter 19. Structures"
  39. "Chapter 20. The Evaluator"
  40. "Chapter 21. Streams"
  41. "Chapter 22. Input & Output"
  42. "Chapter 23. File System Interf…"
  43. "Chapter 24. Errors"
  44. "Chapter 25. Misc. Features"
  45. "Chapter 26. Loop"
  46. "Chapter 27. Pretty Printing"
  47. "Chapter 28. CLOS"
  48. "Chapter 29. Conditions"
  49. "PowerLisp Doc"
  50. ))
  51.  
  52. (defvar cltl2-directory ":Documentation:")
  53. (defvar cltl2-index-name "cltl2-index.lisp")
  54.  
  55. (defun process-doc-files (&key (start 1) (end (length cltl2-chapters)))
  56.     (do* ((chap (nthcdr (1- start) cltl2-chapters) (cdr chap))
  57.           (index start (1+ index)))
  58.          ((or (null chap) (> index end)))
  59.         (let ((filename (concatenate 'string cltl2-directory (car chap))))
  60.             (compile-doc-file index))))
  61.  
  62. (defun compile-doc-file (index)
  63.     (let* ((menu (nth (1- index) cltl2-chapters))
  64.           (filename (concatenate 'string cltl2-directory menu)))
  65.         (pl:ed filename)
  66.         (pl:set-selection filename 0 0 0 0)
  67.         (do (string (found t) pos result)
  68.             ((not found))
  69.             (setq found (pl:select-next-bold-string filename))
  70.             (if found
  71.                 (progn
  72.                     (setq string (string-trim '(#\Newline #\Space) (pl:get-selection-string filename)))
  73.                     (setq pos (pl:get-selection-position filename))
  74.                     (setq result (multiple-value-list (find-symbol (string-upcase string) :common-lisp)))
  75.                     (if (eq (cadr result) :external)
  76.                         ;; if the string represents a common lisp external symbol
  77.                         (format t "(asd '~A ~S ~{~S ~})~%" string index pos)
  78.                         ;; else just set up a menu selection tag
  79.                         (format t "(adr ~S ~S ~{~S ~})~%" string index pos)))))
  80.         (pl:close-edit-window filename)))
  81.  
  82. (defun asd (symbol index &rest selection)
  83.     (let* ((menu (nth (1- index) cltl2-chapters))
  84.           (filename (concatenate 'string cltl2-directory menu)))
  85.         (push (list 'common-lisp filename selection) (get symbol 'documentation))
  86.         (pl:add-menu-item `(:command ,(symbol-name symbol) (documentation ',symbol 'common-lisp)) menu 500)))
  87.  
  88. (defun adr (string index &rest selection)
  89.     (let* ((menu (nth (1- index) cltl2-chapters))
  90.           (filename (concatenate 'string cltl2-directory menu)))
  91.         (pl:add-menu-item 
  92.             `(:command ,string 
  93.                 (progn (pl:ed ,filename) 
  94.                     (pl:set-selection ,filename 
  95.                         ,(first selection)
  96.                         ,(second selection)
  97.                         ,(third selection)
  98.                         ,(fourth selection)))) 
  99.             menu 500)))
  100.  
  101. (defun documentation (symbol &optional (type 'function))
  102.     (let ((doclist (get symbol 'documentation))
  103.           doc-clause)
  104.         
  105.         ;; if the requested symbol is in the common-lisp package, and
  106.         ;; has documentation of type common-lisp as the first type, then
  107.         ;; use a special algorithm to display the information from CLTL2 text
  108.         (if (and (eq (caar doclist) 'common-lisp) 
  109.                 (eq (symbol-package symbol) (find-package 'common-lisp)))
  110.             (setq type 'common-lisp))
  111.         (setq doc-clause (assoc type doclist))
  112.         (unless doc-clause 
  113.             (return (format nil "No documentation available for ~A ~A" type symbol)))
  114.         (if (and (eq (first doc-clause) 'common-lisp)
  115.                 (probe-file (second doc-clause)))
  116.             (let ((filename (second doc-clause))
  117.                   (selection (third doc-clause)))
  118.                 (pl:ed filename)
  119.                 (pl:set-selection filename 
  120.                     (first selection)
  121.                     (second selection)
  122.                     (third selection)
  123.                     (fourth selection))
  124.                 "Common Lisp, the Language, 2nd edition, courtesy of Digital Press and Guy Steele")
  125.             ;; else just return the doc string
  126.             (cdr doc-clause))))
  127.  
  128. ;;
  129. ;; load the index file if it exists, and create the menu structure
  130. (let ((index-file (concatenate 'string cltl2-directory cltl2-index-name)))
  131.     (pl:add-menu-item '(:menu "Documentation") nil 0)
  132.     (pl:add-menu-item '(:menu "PowerLisp Doc") "Documentation" 0)
  133.     (if (probe-file index-file)
  134.         (progn                             
  135.             (pl:add-menu-item '(:command "---" nil) "Documentation" 100)
  136.             (pl:add-menu-item '(:command "Common Lisp the Language" nil) "Documentation" 100)
  137.             (pl:add-menu-item '(:command "---" nil) "Documentation" 100)
  138.             (dolist (chap (butlast cltl2-chapters))
  139.                 (pl:add-menu-item (list :menu chap) "Documentation" 100))
  140.             (load index-file))))
  141.  
  142.         
  143. ;;(adr "PowerLisp" 30 1 6 1 15 )
  144. (adr "Contents" 30 19 6 20 0 )
  145. (adr "Introduction" 30 82 0 84 0 )
  146. (adr "Licensing" 30 158 0 160 0 )
  147. (adr "Quick Start Tutorial" 30 267 0 269 0 )
  148. (adr "Files in this Release" 30 466 0 468 0 )
  149. (adr "Interactive Environment" 30 545 0 547 0 )
  150. (adr "Preferences" 30 629 0 630 0 )
  151. (adr "PowerEdit Text Editor" 30 656 0 658 0 )
  152. (adr "PowerLisp Compiler" 30 819 0 819 18 )
  153. (adr "68k Compiler" 30 822 0 822 12 )
  154. (adr "PowerPC Compiler" 30 871 0 872 0 )
  155. (adr "PowerLisp Assembler" 30 898 0 900 0 )
  156. (adr "PowerLisp Disassembler" 30 934 0 936 0 )
  157. (adr "Linking and Debugging" 30 956 0 958 0 )
  158. (adr "Memory Usage" 30 1012 0 1014 0 )
  159. (adr "Operating System Issues" 30 1064 0 1066 0 )
  160. (adr "Common Lisp Implementation" 30 1084 0 1086 0 )
  161. (adr "CLOS" 30 1444 0 1445 0 )
  162. (adr "Non-standard Extensions" 30 1534 0 1536 0 )
  163. (adr "New Features" 30 1635 0 1636 0 )
  164. (adr "Troubleshooting" 30 1708 0 1710 0 )
  165. (adr "Notes" 30 1801 0 1802 0 )
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.